﻿module public HtmlParser

open System
open Dom
open HtmlDom
open HtmlScanner
open Utils

(*
    Supports all HTML elements in HTML 2.0
    Except the ones obsoleted in HTML5: dir, isindex, tt, xmp, listing
    
*)

(* 
    We still parse the obsolete and unsupported self-closing elements in html5
    <script> is special-caded since it may be self-closing depending on src attribute *)
let selfClosing = [
    "area"; "base"; "br"; "col"; "command"; "embed"; "hr"; "img"; "input";
    "keygen"; "link"; "meta"; "param"; "source"; "track"; "wbr"; "isindex"
    ]
let headElements = ["title";"base";"link";"meta"]
let headAllowedElements = ["style";"script"]

let isHeadElement tagName = contains tagName headElements
let isHeadAllowed tagName = contains tagName headElements || contains tagName headAllowedElements

   
let rec findInStack (node:Node) tagName =
    match node with 
    |  :? Element as elem ->
            if elem.tagName = tagName then Some elem else findInStack node.parentNode tagName
    |  :? Document -> None

let rec findDocument (node:Node) =
    match node with 
    |  :? Element as elem -> findDocument node.parentNode
    |  :? Document as doc -> doc 

let parseHtmlTokens (doc:Document) tokens =     
    let rec parseHtml1 (tokenlist:Token list) (parent:ParentNode) =
        match tokenlist with
        | [] -> parent
        | token::rest ->
            match token with 
            | :? TextToken as text -> 
                    let parentElem = parent :?> Element
                    do parentElem.appendChild(doc.createTextNode(text.text)) |> ignore
                    parseHtml1 rest parent
            | :? StartTag as startTag -> 
                    let newElem = doc.createElement(startTag.tagName, startTag.attributes)
                    processInContext rest parent newElem
            | :? EndTag as endTag -> 
                    match findInStack parent endTag.tagName with
                    | Some element -> 
                        let newParent = element.parentNode
                        parseHtml1 rest newParent 
                    | None ->
                        // unmatched closing tag - we just ignore
                        parseHtml1 rest parent
            | _ -> parent

    // select a new node as parent
    and selectParent (tokens:Token list) (parent:Element)  =
        parseHtml1 tokens parent

    and add (tokens:Token list) (parent:Element) (newElement:Element) =
        do parent.appendChild(newElement) |> ignore
        let newParent =
            if Seq.exists ((=) newElement.tagName) selfClosing
                  then parent
                  else newElement
        parseHtml1 tokens newParent    

     // select a new node as parent
    and selectParentAndAdd (tokens:Token list) (newParent:Element) (newElement:Element)  =
        add tokens newParent newElement

    and processInContext (tokens:Token list) (parent:Node) (newElem:Element) =
        match parent with
        | :? Document as doc ->                            
            // top level
            let html = doc.documentElement
            if newElem.tagName="html"
            then selectParent tokens html
            else processInContext tokens html newElem
        | :? HTMLHtmlElement as html ->
            // inside html
            if newElem.tagName = "head"
                then selectParent tokens html.headElement
            elif newElem.tagName = "body"
                then selectParent tokens html.bodyElement
            elif isHeadElement newElem.tagName
                then processInContext tokens html.headElement newElem
                else processInContext tokens html.bodyElement newElem 
        | :? Element as parentElem ->
            if parentElem.tagName="head" && not (isHeadAllowed newElem.tagName)
            then 
                // non-head in head context - switch to body
                let html = doc.documentElement
                let body = html.bodyElement
                processInContext tokens body newElem
            else add tokens parentElem newElem    

    do parseHtml1 tokens doc |> ignore   


let parseHtml doc html = 
    do parseHtmlTokens doc (scan html)
    do doc.dispatchEvent(Event("DOMContentLoaded"))

let rec dumpNode (node:Node) =
    match node with
    | :? Document as doc -> dumpNode doc.documentElement
    | :? Element as elem -> "(" + elem.tagName + " " + (dumpList elem.childNodes) + ")"
    | :? Text as txt -> 
        let sample = if txt.nodeValue.Length<20 then txt.nodeValue else txt.nodeValue.Substring(0, 20) + "..."
        "'" + sample + "'"
   
and dumpList nodes = String.Join(" ", (Seq.map dumpNode nodes))